home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / mail / tag_tool.zip / TAG-SORT.CBL < prev    next >
Text File  |  1992-10-26  |  5KB  |  137 lines
  1. 000100 IDENTIFICATION DIVISION.
  2. 000200 PROGRAM-ID.     TAG-SORT.
  3. 000300*
  4. 000400*
  5. 000500 AUTHOR.         BIT-by-BIT SOFTWARE COMPANY (ROGER CRAVENS).
  6. 000600 INSTALLATION.   ATLANTA, GEORGIA.
  7. 000700 DATE-WRITTEN.   10/25/1992.
  8. 000800 DATE-COMPILED.  10/25/1992.
  9. 000900 SECURITY.       COPYRIGHT 1992.
  10. 001000*
  11. 001100*
  12. 001200 ENVIRONMENT DIVISION.
  13. 001300 CONFIGURATION SECTION.
  14. 001400 SOURCE-COMPUTER.  IBM-PERSONAL-COMPUTER.
  15. 001500 OBJECT-COMPUTER.  IBM-PERSONAL-COMPUTER.
  16. 001600 SPECIAL-NAMES.
  17. 001700*    CRT STATUS IS KEY-STATUS
  18. 001800*    CURSOR     IS WS-CURSOR.
  19. 001900 INPUT-OUTPUT SECTION.
  20. 002000 FILE-CONTROL.
  21. 002100*
  22. 002200     SELECT TAGLINE-FILE-IN
  23. 002300         ASSIGN TO DISK
  24. 002400         ORGANIZATION LINE SEQUENTIAL
  25. 002500         ACCESS MODE IS SEQUENTIAL.
  26. 002600*
  27. 002700     SELECT TAGLINE-FILE-OUT
  28. 002800         ASSIGN TO DISK
  29. 002900         ORGANIZATION LINE SEQUENTIAL
  30. 003000         ACCESS MODE IS SEQUENTIAL.
  31. 003100*
  32. 003200     SELECT SORT-TAGLINE
  33. 003300         ASSIGN TO DISK.
  34. 003400*
  35. 003500***********************************************************
  36. 003600*     D A T A    D I V I S I O N                          *
  37. 003700***********************************************************
  38. 003800 DATA DIVISION.
  39. 003900*
  40. 004000 FD  TAGLINE-FILE-IN
  41. 004100     LABEL RECORDS STANDARD
  42. 004200     RECORD IS VARYING FROM 1 TO 80 CHARACTERS
  43. 004300     VALUE OF FILE-ID IN-FILE.
  44. 004400 01  TAGLINE-RECORD-IN.
  45. 004500     05  TAGLINE-IN                      PIC X(80).
  46. 004600*
  47. 004700 FD  TAGLINE-FILE-OUT
  48. 004800     LABEL RECORDS STANDARD
  49. 004900     RECORD IS VARYING FROM 1 TO 80 CHARACTERS
  50. 005000     VALUE OF FILE-ID OUT-FILE.
  51. 005100 01  TAGLINE-RECORD-OUT.
  52. 005200     05  TAGLINE-OUT                     PIC X(80).
  53. 005300*
  54. 005400 SD  SORT-TAGLINE
  55. 005500     LABEL RECORDS STANDARD
  56. 005600     RECORD IS VARYING FROM 1 TO 80 CHARACTERS.
  57. 005700 01  SORTED-TAGLINE-RECORD.
  58. 005800     05  SORTED-TAGLINE                  PIC X(80).
  59. 005900*
  60. 006000
  61. 006100***********************************************************
  62. 006200*   W O R K I N G   S T O R A G E   S E C T I O N         *
  63. 006300***********************************************************
  64. 006400 WORKING-STORAGE SECTION.
  65. 006500
  66. 006600 01  IN-FILE                             PIC X(12).
  67. 006700 01  OUT-FILE                            PIC X(12).
  68. 006800 01 ASCENDING-ORDER                      PIC X.
  69. 006900 01 DESCENDING-ORDER                     PIC X.
  70. 007000*
  71. 007100***********************************************************
  72. 007200*   S C R E E N   S E C T I O N                           *
  73. 007300***********************************************************
  74. 007400 SCREEN SECTION.
  75. 007500 01 MAINMENU.
  76. 007600   02 BLANK SCREEN.
  77. 007700   02 LINE 3 COL 10 VALUE "┌──────────────────────────────────────
  78. 007800-"───────────┐".
  79. 007900   02 LINE 4 COL 10 VALUE "│ IN/OUT ASCII TAGLINE SORT FILES
  80. 008000-"           │".
  81. 008100   02 LINE 5 COL 10 VALUE "├──────────────────────────────────────
  82. 008200-"───────────┤".
  83. 008300   02 LINE 6 COL 10 VALUE "│
  84. 008400-"           │".
  85. 008500   02 LINE 7 COL 10 VALUE "│ FILENAME IN:  [            ]
  86. 008600-"           │".
  87. 008700   02 LINE 8 COL 10 VALUE "│
  88. 008800-"           │".
  89. 008900   02 LINE 9 COL 10 VALUE "│ FILENAME OUT: [            ]
  90. 009000-"           │".
  91. 009100   02 LINE 10 COL 10 VALUE "│
  92. 009200-"            │".
  93. 009300   02 LINE 11 COL 10 VALUE "│ ASCENDING ORDER: [ ]  DESCENDING ORD
  94. 009400-"ER: [ ]     │".
  95. 009500   02 LINE 12 COL 10 VALUE "│
  96. 009600-"            │".
  97. 009700   02 LINE 13 COL 10 VALUE "│ USE <TAB> KEY TO TAB DOWN
  98. 009800-"            │".
  99. 009900   02 LINE 14 COL 10 VALUE "│ PRESS <ENTER> KEY WHEN DONE!
  100. 010000-"            │".
  101. 010100   02 LINE 15 COL 10 VALUE "└─────────────────────────────────────
  102. 010200-"────────────┘".
  103. 010300   02 LINE 7 COL 27 PIC X(12) USING IN-FILE.
  104. 010400   02 LINE 9 COL 27 PIC X(12) USING OUT-FILE.
  105. 010500   02 LINE 11 COL 30 PIC X    USING ASCENDING-ORDER.
  106. 010600   02 LINE 11 COL 53 PIC X    USING DESCENDING-ORDER.
  107. 010700*
  108. 010800***********************************************************
  109. 010900*   P R O C E D U R E   D I V I S I O N                   *
  110. 011000***********************************************************
  111. 011100 PROCEDURE DIVISION.
  112. 011200*
  113. 011300 0000-CONTROL SECTION.
  114. 011400     DISPLAY MAINMENU.
  115. 011500     ACCEPT  MAINMENU.
  116. 011600     IF IN-FILE = SPACES OR OUT-FILE = SPACES
  117. 011700         STOP RUN.
  118. 011800*
  119. 011900     IF DESCENDING-ORDER = SPACES
  120. 012000         PERFORM 0010-ASCENDING-ROUTINE
  121. 012100     ELSE
  122. 012200         PERFORM 0010-DESCENDING-ROUTINE.
  123. 012300*
  124. 012400     STOP RUN.
  125. 012500*
  126. 012600 0010-DESCENDING-ROUTINE.
  127. 012700     SORT SORT-TAGLINE ON DESCENDING SORTED-TAGLINE
  128. 012800         USING  TAGLINE-FILE-IN
  129. 012900         GIVING TAGLINE-FILE-OUT.
  130. 013000
  131. 013100 0010-ASCENDING-ROUTINE.
  132. 013200     SORT SORT-TAGLINE ON ASCENDING SORTED-TAGLINE
  133. 013300         USING  TAGLINE-FILE-IN
  134. 013400         GIVING TAGLINE-FILE-OUT.
  135. 013500*
  136. 013600******************>>>>  END OF PROGRAM TAG-SORT
  137.